perm filename WAVE.FAI[TMP,LCS]4 blob
sn#211906 filedate 1976-04-21 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00008 PAGES
00200 C REC PAGE DESCRIPTION
00300 C00001 00001
00400 C00002 00002 TITLE WAVE
00500 C00004 00003 L101: SETOM X#
00600 C00006 00004 L6: JSA 16,DPYOUT
00700 C00008 00005 ININT: SETZ
00800 C00009 00006 GNAME: SETZM FILEXT+1
00900 C00010 00007 GETNAM: MOVEI A,
01000 C00011 00008 DSKIN: MOVE NN,[INPO: IOWD =1024,WD]
01100 C00012 ENDMK
01200 C⊗;
00100 TITLE WAVE
00200 EXTERNAL TYPLOC,DDCLR,DPYSET
00300 EXTERNAL DPYOUT,AVECT,ALINE
00400 A←1 ↔ B←2 ↔ C←3 ↔ K←4 ↔ NN←7 ↔ LPDL←←69 ↔ P←17
00500 DEFINE FIXX(N)
00600 < JUMPGE N,.+5
00700 MOVNS N
00800 FIX N,233000
00900 MOVNS N
01000 CAIA
01100 FIX N,233000 >
01200 DEFINE FLOAT(N)
01300 < TLC N,232000
01400 FADR N,N >
01500 BEG: MOVE P,[-LPDL,,PDL-1]
01600 JSA 16,TYPLOC
01700 [-=260]
01800 [-=512]
01900 TRYOV: CLRBFI
02000 OUTSTR [ASCIZ/ TYPE FILE NAME /]
02100 PUSHJ P,GNAME
02200
02300 OPEN 11,[17↔'DSK '↔0]
02400 JRST 4,.
02500 LOOKUP 11,FILNAM
02600 JRST TRYOV
02700
02800 HRRZI A,=512
02900 HRRZM A,INC#
03000 L8: CLRBFI
03100 OUTSTR [ASCIZ/ TYPE NUM OF SAMPLES /]
03200 HRRZI A,=1024
03300 HRRZM A,NZ#
03400 INCHWL B
03500 PUSHJ P,ININT
03600 MOVEM J#
03700 SETZ
03800 INCHRS B
03900 CAIA
04000 PUSHJ P,ININT
04100 IDIVI 3
04200 MOVEM NY#
04300 SKIPE B,J
04400 MOVEM B,INC
04500
04600 SETZM JCNT#
04700 HRRZI A,1
04800 HRRZM A,KCNT#
04900 SETZM JZ#
05000 L11: HRRZI A,1
05100 HRRZM A,L#
05200 MOVE A,INC
05300 MOVEM A,LX#
05400
05500 L100: PUSHJ P,DSKIN
05600
05700 ; JSA 16,FASTIN
05800 ; WD
05900 ; [=1024]
06000
06100 HRRZI A,=1024
06200 ADDB A,NZ
06300 CAMGE A,NY
06400 JRST L100
06500 SKIPN NY
06600 JRST L101
06700 SUBI A,=1024
06800 IMULI A,3
06900 MOVEM A,KCNT
07000 SOJ A,
07100 MOVEM A,JCNT
00100 L101: SETOM X#
00200 SETZ K,
00300 MOVE A,[POINT 12,WD]
00400 L2: SKIPE WD(K)
00500 SETZM X
00600 ILDB 0,A
00700 HRRZM 0,FW(K)
00800 ILDB 0,A
00900 HRRZM 0,FW+1(K)
01000 ILDB 0,A
01100 HRRZM 0,FW+2(K)
01200 ADDI K,3
01300 CAIGE K,=3072
01400 JRST L2
01500 ; SKIPE X ADD THIS TO RESTART ON ZEROS
01600 ; JRST L8
01700 L1: JSA 16,DDCLR
01800 MOVE A,[=1000.0]
01900 MOVE B,INC
02000 FLOAT(B)
02100 FDVR A,B
02200 MOVEM A,X
02300 L40: JSA 16,DPYSET
02400 [1]
02500 DP
02600 [=4000]
02700 JSA 16,ALINE
02800 NFHD
02900 [=409]
03000 NFHD
03100 [-=409]
03200 JSA 16,ALINE
03300 [=500]
03400 ZER
03500 NFHD
03600 ZER
03700 L10: MOVE A,[-=500.0]
03800 MOVEM A,Z#
03900 MOVE K,L
04000 L4: AOS JCNT
04100 MOVE A,FW-1(K)
04200 CAILE A,=2047
04300 SUBI A,=4096
04400 MOVEM A,JZ
04500 IDIVI A,5
04600 MOVEM A,JY#
04700 MOVE A,Z
04800 FIXX(A)
04900 MOVEM A,JX#
05000 JSA 16,AVECT
05100 JX
05200 JY
05300 CAIN K,=3072
05400 JRST L6
05500 MOVE A,X
05600 FADM A,Z
05700 CAMGE K,LX
05800 AOJA K,L4
00100 L6: JSA 16,DPYOUT
00200 [1]
00300 L31: OUTSTR [ASCIZ/ SMPL /]
00400 MOVE KCNT
00500 PUSHJ P,OUTINT
00600 OUTSTR [ASCIZ/ TO /]
00700 MOVE JCNT
00800 PUSHJ P,OUTINT
00900 OUTSTR [ASCIZ/
01000 /]
01100 L55: MOVE A,J
01200 AOJ A,
01300 JUMPE A,L7
01400 AOJ A,
01500 JUMPE A,L12
01600 L5: CLRBFI
01700 INCHWL B
01800 PUSHJ P,ININT
01900 MOVEM J
02000 SETZ
02100 INCHRS B
02200 CAIA
02300 PUSHJ P,ININT
02400 MOVEM NX
02500 HRRZI A,=3072
02600 CAMGE A,J
02700 MOVEM A,J
02800 L77: SKIPLE A,J
02900 MOVEM A,INC
03000 ADDI A,2
03100 JUMPGE A,L7
03200 JRST L9
03300 L12: MOVE A,L
03400 ADD A,NX#
03500 MOVEM A,LX
03600 MOVE A,KCNT
03700 ADD A,NX
03800 SOJ A,
03900 MOVEM A,JCNT
04000 JRST L7
04100 L9: MOVE A,L
04200 ADD A,J
04300 MOVEM A,LX
04400 MOVE A,KCNT
04500 ADD A,J
04600 SOJ A,
04700 MOVEM A,JCNT
04800 SKIPGE LX
04900 SETZM LX
05000 L7: MOVE A,LX
05100 AOJ A,
05200 MOVEM A,L
05300 MOVE A,INC
05400 ADDM A,LX
05500 MOVE A,JCNT
05600 AOJ A,
05700 MOVEM A,KCNT
05800 MOVE A,L
05900 CAILE A,=3072
06000 JRST L11
06100 JRST L1
00100 ININT: SETZ
00200 SETZ C,
00300 CAIN B,"-"
00400 JRST MIN
00500 RECUR: CAIL B,60
00600 CAILE B,71
00700 JRST SYNE
00800 IMULI =10
00900 ADDI -60(B)
01000 GTCHR: INCHRS B
01100 CAIA
01200 JRST RECUR
01300 SYNE: SKIPGE C
01400 MOVNS
01500 POPJ P,
01600 MIN: SETO C,
01700 JRST GTCHR
01800
01900 OUTINT: HRRZI B,16
02000 JUMPE OUTZ
02100 IDIVI =10
02200 ADDI A,60
02300 HRRZM A,BLK1(B)
02400 SOJGE B,OUTINT+1
02500 OCHR: OUTCHR BLK1+1(B)
02600 CAIGE B,15
02700 AOJA B,OCHR
02800 POPJ P,
02900 OUTZ: CAIL B,16
03000 HRLZI B,300000
03100 JRST OCHR
03200
03300 INA5: SETZ A,
03400 HRLZI C,700
03500 INCHWL
03600 CAIE 15
03700 CAIN 12
03800 POPJ P,
03900 IDPB C
04000 TRNN A,177
04100 INCHRS
04200 POPJ P,
04300 JRST .-7
04400
00100 GNAME: SETZM FILEXT+1
00200 SETZM FILPPN
00300 MOVE A,['DMD ']
00400 MOVEM A,FILEXT
00500 PUSHJ P,GETNAM
00600 SKIPN A
00700 MOVE A,['MUSAA ']
00800 GEXT: MOVEM A,FILNAM
00900 CAIE C,"."
01000 JRST NOEXTN
01100 PUSHJ P,GETNAM
01200 MOVEM A,FILEXT
01300 NOEXTN: CAIE C,"["
01400 JRST FFDX
01500 PUSHJ P,GETP
01600 HRLZM A,FILPPN
01700 PUSHJ P,GETP
01800 HRRM A,FILPPN
01900 FFDX: INCHRW C
02000 CAIE C,12
02100 JRST FFDX
02200 POPJ P,
00100 GETNAM: MOVEI A,
00200 MOVE B,[440600,,A]
00300 GETNML: PUSHJ P,RCH
00400 POPJ P,
00500 SUBI C,40
00600 TLNE B,770000
00700 IDPB C,B
00800 JRST GETNML
00900
01000 GETP: MOVEI A,
01100 GETPL: PUSHJ P,RCH
01200 POPJ P,
01300 TRNE A,770000
01400 JRST GETPL
01500 LSH A,6
01600 ADDI A,-40(C)
01700 JRST GETPL
01800
01900 RCH: INCHWL C
02000 CAIN C,42
02100 JRST RCHQ
02200 CAIE C,11
02300 CAIN C," "
02400 JRST RCH
02500 CAIE C,"."
02600 CAIN C,","
02700 POPJ P,
02800 CAIE C,"["
02900 CAIN C,"]"
03000 POPJ P,
03100 RCHQR: CAIGE C,40
03200 POPJ P,
03300 CAIL C,"a"
03400 CAILE C,"z"
03500 CAIA
03600 SUBI C,40
03700 POPJ1: AOS (P)
03800 POPJ P,
03900
04000 RCHQ: INCHWL C
04100 JRST RCHQR
00100 DSKIN: MOVE NN,[INPO: IOWD =1024,WD]
00150 MOVEI NN+1,0
00200 INPUT 11,NN
00300 POPJ P,
00400
00500 FILNAM: 0
00600 FILEXT: 0
00700 0
00800 FILPPN: 0
00900
01000 BLK1: BLOCK 17
01100 DP: 0
01200
01300 WD: BLOCK =1024
01400
01500 FW: BLOCK =1024*3
01600
01700 NFHD: -=500
01800 ZER: 0
01900 PDL: BLOCK LPDL
02000 END BEG